home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Packages / switchTo.tcl < prev    next >
Encoding:
Text File  |  1997-10-08  |  2.3 KB  |  85 lines  |  [TEXT/ALFA]

  1. ## -*-Tcl-*- (install)
  2.  # ###################################################################
  3.  #  Alpha - new Tcl folder configuration
  4.  # 
  5.  #  FILE: "switchTo.tcl"
  6.  #                                    created: 18/9/97 {2:52:46 pm} 
  7.  #                                last update: 8/10/97 {8:33:10 pm} 
  8.  #  
  9.  # Reorganisation carried out by Vince Darley with much help from Tom 
  10.  # Fetherston, Johan Linde and suggestions from the Alpha-D mailing list.  
  11.  # Alpha is shareware; please register with the author using the register 
  12.  # button in the about box.
  13.  #  
  14.  # Description:
  15.  # 
  16.  # Adds a 'Switch To' menu to Alpha's Utils menu.
  17.  # ###################################################################
  18.  ##
  19.  
  20. alpha::extension switchToMenu 0.1 {
  21.     menu::buildProc switchTo menu::buildSwitchTo
  22.     menu::insert Utils submenu end switchTo
  23. } help {Adds a 'switch to' menu to the Utils menu}
  24.  
  25. proc menu::buildSwitchTo {} {
  26.     global switchApps
  27.     menu -m -n switchTo -p menu::switchTo {"<O<I/NNow…" "Add…" "Remove…" "(-"}
  28.     
  29.     if {[info exists switchApps] && [llength $switchApps]} {
  30.         foreach app $switchApps {
  31.             lappend names [list [file tail $app] [file::getSig $app]]
  32.         }
  33.         foreach name [lsort -ignore $names] {
  34.             set sig [lindex $name 1]
  35.             if {[set p [lsearch -glob $names "* $sig"]] != -1} {
  36.                 addMenuItem -m -l "/\x1e s[icon::MenuFromSig $sig]" switchTo "[lindex $name 0]"
  37.             } else {
  38.                 addMenuItem -m -l "blah" switchTo "[lindex $name 0]"
  39.             }
  40.             
  41.         }
  42.     }
  43. }
  44.  
  45. proc menu::switchTo {menu name} {
  46.     global switchTo switchApps
  47.  
  48.     if {$name == "Add"} {
  49.         set fname [getfile "Pick an app:"]
  50.         lappend switchApps $fname
  51.         addDef switchApps $switchApps
  52.         menu::buildSwitchTo
  53.     } elseif {$name == "Remove"} {
  54.         foreach app $switchApps {
  55.             lappend apps [file tail $app]
  56.         }
  57.         set name [listpick -p "Remove which app?" $apps]
  58.         if {[set ind [lsearch $switchApps "*$name"]] >= 0} {
  59.             set switchApps [lreplace $switchApps $ind $ind]
  60.             addDef switchApps $switchApps
  61.             menu::buildSwitchTo
  62.         }
  63.     } elseif {$name == "Now"} {
  64.         switchApp
  65.     } else {
  66.         if {[set ind [lsearch $switchApps "*$name"]] >= 0} {
  67.             if {[catch {switchTo $name}]} {
  68.                 launch -f [lindex $switchApps $ind]
  69.             }
  70.         }
  71.     }
  72. }
  73.  
  74. proc switchApp {} {
  75.     set procs ""
  76.     foreach p [processes] {
  77.         lappend procs [lindex $p 0]
  78.     }
  79.     set to [listpick -p "Switch to app:" [lsort $procs]]
  80.     if {[string length $to]} {
  81.         switchTo $to
  82.     }
  83. }
  84.  
  85.